home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / Xlisp_Source.cpt / xldbug.c < prev    next >
Text File  |  1985-04-09  |  4KB  |  197 lines
  1. /* xldebug - xlisp debugging support */
  2.  
  3. #include "xlisp.h"
  4.  
  5. #ifdef MEGAMAX
  6. overlay "overflow"
  7. #endif
  8.  
  9. /* external variables */
  10. extern long total;
  11. extern int xldebug;
  12. extern int xltrace;
  13. extern NODE *s_unbound;
  14. extern NODE *s_stdin,*s_stdout;
  15. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  16. extern NODE *s_continue,*s_quit;
  17. extern NODE *xlstack;
  18. extern NODE *true;
  19. extern NODE **trace_stack;
  20.  
  21. /* external routines */
  22. extern char *malloc();
  23.  
  24. /* forward declarations */
  25. FORWARD NODE *stacktop();
  26.  
  27. /* xlfail - xlisp error handler */
  28. xlfail(emsg)
  29.   char *emsg;
  30. {
  31.     xlerror(emsg,stacktop());
  32. }
  33.  
  34. /* xlabort - xlisp serious error handler */
  35. xlabort(emsg)
  36.   char *emsg;
  37. {
  38.     xlsignal(emsg,s_unbound);
  39. }
  40.  
  41. /* xlbreak - enter a break loop */
  42. xlbreak(emsg,arg)
  43.   char *emsg; NODE *arg;
  44. {
  45.     breakloop("break",NULL,emsg,arg,TRUE);
  46. }
  47.  
  48. /* xlerror - handle a fatal error */
  49. xlerror(emsg,arg)
  50.   char *emsg; NODE *arg;
  51. {
  52.     doerror(NULL,emsg,arg,FALSE);
  53. }
  54.  
  55. /* xlcerror - handle a recoverable error */
  56. xlcerror(cmsg,emsg,arg)
  57.   char *cmsg,*emsg; NODE *arg;
  58. {
  59.     doerror(cmsg,emsg,arg,TRUE);
  60. }
  61.  
  62. /* xlerrprint - print an error message */
  63. xlerrprint(hdr,cmsg,emsg,arg)
  64.   char *hdr,*cmsg,*emsg; NODE *arg;
  65. {
  66.     NODE *file;
  67.     file = s_stdout->n_symvalue;
  68.     xlputstr(file,hdr); xlputstr(file,": "); xlputstr(file,emsg);
  69.     if (arg != s_unbound) { xlputstr(file," - "); stdprint(arg); }
  70.     else xlputc(file,'\n');
  71.     if (cmsg) {
  72.     xlputstr(file,"if continued: ");
  73.     xlputstr(file,cmsg);
  74.     xlputc(file,'\n');
  75.     }
  76. }
  77.  
  78. /* doerror - handle xlisp errors */
  79. LOCAL doerror(cmsg,emsg,arg,cflag)
  80.   char *cmsg,*emsg; NODE *arg; int cflag;
  81. {
  82.     /* make sure the break loop is enabled */
  83.     if (s_breakenable->n_symvalue == NIL)
  84.     xlsignal(emsg,arg);
  85.  
  86.     /* call the debug read-eval-print loop */
  87.     breakloop("error",cmsg,emsg,arg,cflag);
  88. }
  89.  
  90. /* breakloop - the debug read-eval-print loop */
  91. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  92.   char *hdr,*cmsg,*emsg; NODE *arg; int cflag;
  93. {
  94.     NODE *oldstk,expr,*val;
  95.     CONTEXT cntxt;
  96.  
  97.     /* increment the debug level */
  98.     xldebug++;
  99.  
  100.     /* print the error message */
  101.     xlerrprint(hdr,cmsg,emsg,arg);
  102.  
  103.     /* flush the input buffer */
  104.     xlflush();
  105.  
  106.     /* do the back trace */
  107.     if (s_tracenable->n_symvalue) {
  108.     val = s_tlimit->n_symvalue;
  109.     xlbaktrace(fixp(val) ? val->n_int : -1);
  110.     }
  111.  
  112.     /* create a new stack frame */
  113.     oldstk = xlsave(&expr,NULL);
  114.  
  115.     /* debug command processing loop */
  116.     xlbegin(&cntxt,CF_ERROR,true);
  117.     while (TRUE) {
  118.  
  119.     /* setup the continue trap */
  120.     if (setjmp(cntxt.c_jmpbuf))
  121.         continue;
  122.  
  123.     /* read an expression and check for eof */
  124.     if (!xlread(s_stdin->n_symvalue,&expr.n_ptr)) {
  125.         expr.n_ptr = s_quit;
  126.         break;
  127.     }
  128.  
  129.     /* check for commands */
  130.     if (expr.n_ptr == s_continue) {
  131.         if (cflag) break;
  132.         else xlabort("this error can't be continued");
  133.     }
  134.     else if (expr.n_ptr == s_quit)
  135.         break;
  136.  
  137.     /* evaluate the expression */
  138.     expr.n_ptr = xleval(expr.n_ptr);
  139.  
  140.     /* print it */
  141.     xlprint(s_stdout->n_symvalue,expr.n_ptr,TRUE);
  142.     xlterpri(s_stdout->n_symvalue);
  143.     }
  144.     xlend(&cntxt);
  145.  
  146.     /* restore the previous stack frame */
  147.     xlstack = oldstk;
  148.  
  149.     /* decrement the debug level */
  150.     xldebug--;
  151.  
  152.     /* continue the next higher break loop on quit */
  153.     if (expr.n_ptr == s_quit)
  154.     xlsignal("quit from break loop",s_unbound);
  155. }
  156.  
  157. /* tpush - add an entry to the trace stack */
  158. xltpush(nptr)
  159.     NODE *nptr;
  160. {
  161.     if (++xltrace < TDEPTH)
  162.     trace_stack[xltrace] = nptr;
  163. }
  164.  
  165. /* tpop - pop an entry from the trace stack */
  166. xltpop()
  167. {
  168.     xltrace--;
  169. }
  170.  
  171. /* stacktop - return the top node on the stack */
  172. LOCAL NODE *stacktop()
  173. {
  174.     return (xltrace >= 0 && xltrace < TDEPTH ? trace_stack[xltrace] : s_unbound);
  175. }
  176.  
  177. /* baktrace - do a back trace */
  178. xlbaktrace(n)
  179.   int n;
  180. {
  181.     int i;
  182.  
  183.     for (i = xltrace; (n < 0 || n--) && i >= 0; i--)
  184.     if (i < TDEPTH)
  185.         stdprint(trace_stack[i]);
  186. }
  187.  
  188. /* xldinit - debug initialization routine */
  189. xldinit()
  190. {
  191.     if ((trace_stack = (NODE **) malloc(TSTKSIZE)) == NULL)
  192.     xlabort("insufficient memory");
  193.     total += (long) TSTKSIZE;
  194.     xltrace = -1;
  195.     xldebug = 0;
  196. }
  197.